perm filename TOTAL[DEN,LMM] blob sn#070822 filedate 1973-11-10 generic text, type T, neo UTF8
(FILECREATED "10-NOV-73 19:43:37" S-TOTAL

     changes to:  Y/N

     previous date: " 7-NOV-73  5:24:46")


  (LISPXPRINT (QUOTE TOTALVARS)
              T)
  [RPAQQ TOTALVARS
         ((* Lisp system type functions)
          (FNS DWIMUSERFN LISTFILE LISTFILES GSETQ GSET Y/N PUTPROP 
               LMLISPFOR FORGETTOKEN FOREXPRESSIONS FORNEXT FORVARNAME 
               FORMAKECOND FORMAKESETQ FORINITIAL FORPROGVAR FORGONEXT 
               FORPACKWORDS FORTESTANDSET FORNEGATION EDITM)
          (USERMACROS ?= !← EF PPT MAC EVAL -)
          [ADDVARS (PRETTYTYPELST (CHANGEDITMACROS USERMACROS 
                                                   "edit macros")
                                  (NEWVARSLST VARS "variables")
                                  (CHANGEDPROPLST PROP "properties")
                                  (CHANGEDADVICELST ADVICE "advice"))
                   (PRETTYMACROS (* X (E (TERPRI)
                                         (PRINT (QUOTE (* . X)))
                                         (TERPRI]
          (VARS (DWIMUSERFN T)
                (HOST)
                (NEWVARSLST)
                (CHANGEDITMACROS)
                (CHANGEDPROPLST)
                (CHANGEDADVICELST)
                LMFORWORDS FORTYPELST)
          (PROP CLISPMACRO FOR)
          (PROP CLISPWORD FOR)
          [P (/PUT (QUOTE *)
                   (QUOTE PRETTYTYPE)
                   (QUOTE (LAMBDA NIL NIL]
          (P (I.S.TYPE (QUOTE MAXIMUM)
                       (QUOTE (SETQ $$VAL (MAX $$VAL *)))
                       -999999
                       (QUOTE $$VAL))
             (I.S.TYPE (QUOTE MINIMUM)
                       (QUOTE (SETQ $$VAL (MIN $$VAL *)))
                       999999
                       (QUOTE $$VAL)))
          (BLOCKS (FORBLOCK LMLISPFOR FORGETTOKEN FOREXPRESSIONS 
                            FORNEXT FORVARNAME FORMAKECOND FORMAKESETQ 
                            FORINITIAL FORPROGVAR FORGONEXT 
                            FORPACKWORDS FORTESTANDSET FORNEGATION
                            (ENTRIES LMLISPFOR)
                            (LOCALFREEVARS TESTSET N INIT VAR NEXT VARS 
                                           PV L]

(* Lisp system type functions)

(DEFINEQ

(DWIMUSERFN
  [LAMBDA NIL

          (* This function is called 
          (if the value of DWIMUSERFN is T) by DWIM if DWIM 
          doesn't think that a "FORM" is CLISP.
          The definition given here says that, if 
          (FOO --) is in the code, and FOO doesn't have a 
          function definition, but does have a macro property, 
          to use the expansion of the macro.
          The call to "CLISPTRAN" puts the translation in the 
          CLISP hash array, where other translations of CLISP 
          are kept)


    (AND (NOT FAULTAPPLYFLG)
         (LISTP FAULTX)
         (LITATOM (CAR FAULTX))
         (NOT (FGETD (CAR FAULTX)))
         (PROG [(MACVAL (OR (GETP (CAR FAULTX)
                                  (QUOTE CLISPMACRO))
                            (GETP (CAR FAULTX)
                                  (QUOTE MACRO]
                                                (* FAULTX is the form 
                                                which was in "ERROR".)
               (AND MACVAL (NOT (EDITFINDP MACVAL (QUOTE ASSEMBLE)))
                    [CLISPTRAN FAULTX
                               (COND
                                 ((FMEMB (CAR MACVAL)
                                         (QUOTE [LAMBDA NLAMBDA]))
                                   (CONS MACVAL (CDR FAULTX)))
                                 [(AND (CAR MACVAL)
                                       (ATOM (CAR MACVAL)))
                                   (EVALA (CADR MACVAL)
                                          (LIST (CONS (CAR MACVAL)
                                                      (CDR FAULTX]
                                 (T (SUBPAIR (CAR MACVAL)
                                             (CDR FAULTX)
                                             (CADR MACVAL]
                    (RETURN FAULTX])

(LISTFILE
  [LAMBDA (LOCALFILE FOREIGNFILE LISTFILEHOST LISTFILELOGIN)
                                                (* Calls FTP as a 
                                                SUBSYS)
    (BKSYSBUF (CONCAT
                "FTP
"
                [SETQ LISTFILEHOST (OR LISTFILEHOST HOST
                                       (SETQ HOST (PROGN (PRIN1 
                                                           "HOST? ")
                                                         (READ T]
                "
LOG "
                [OR LISTFILELOGIN (GETP LISTFILEHOST (QUOTE LOGIN))
                    (AND (EQ LISTFILEHOST (QUOTE SAIL))
                         (SETQ LISTFILELOGIN (SELECTQ (MKATOM (USERNAME)
                                                              )
                                                      (MASINTER
                                                        "DEN,LMM")
                                                      (SRIDHARAN 
                                                            "1,NSS")
                                                      (CARHART "1,RC")
                                                      NIL))
                         (EQ (APPLY* (QUOTE Y/N)
                                     (QUOTE Y)
                                     (CONCAT "SAIL login as " 
                                             LISTFILELOGIN "? "))
                             (QUOTE Y))
                         LISTFILELOGIN)
                    (PUT LISTFILEHOST (QUOTE LOGIN)
                         (PROGN (PRIN1 LISTFILEHOST T)
                                (PRIN1 " login? " T)
                                (READ T]
                "
TE
SE " LOCALFILE "

" (OR FOREIGNFILE
      (PROGN [SETQ FOREIGNFILE
               (SUBSTRING LOCALFILE
                          ([LAMBDA (TEM)
                              (OR (STRPOS "S-" LOCALFILE TEM NIL T T)
                                  TEM]
                            (OR (STRPOS ">" LOCALFILE NIL NIL NIL T)
                                1))
                          (SUB1 (OR (STRPOS ";" LOCALFILE)
                                    0]
             (COND
               ((EQ (NTHCHAR FOREIGNFILE -1)
                    (QUOTE %.))
                 (GLC FOREIGNFILE)))
             FOREIGNFILE))
                "
DIS
QUI
QUI
"))
    (KFORK (SUBSYS))
    LOCALFILE])

(LISTFILES
  [LAMBDA (FILLST)                              (* TO REDEFINE LISTFILES
                                                TO FTP FILES ELSEWHERE)
    [MAPC (OR FILLST NOTLISTEDFILES)
          (FUNCTION (LAMBDA (FIL)
              (LISTFILE (OR (INFILEP FIL)
                            (ERROR "no such file:" FIL)))
              (/DSUBST NIL FIL NOTLISTEDFILES]
    (SETQ NOTLISTEDFILES (/DREMOVE NIL NOTLISTEDFILES))
    FILLST])

(GSETQ
  [NLAMBDA (GSETVAR Y)                          (* Guaranteed to cause 
                                                VARS to be marked as 
                                                "CHANGED")
    (GSET GSETVAR (EVAL Y])

(GSET
  [LAMBDA (X Y)                                 (* Guaranteed to cause 
                                                VARS to be marked as 
                                                "CHANGED")
    (PROG1 (/SET X Y)
           (/RPLACA (QUOTE NEWVARSLST)
                    (CONS X NEWVARSLST])

(Y/N
  [NLAMBDA (DEFAULT MESS TYPEAHEADOKFLG)

          (* Prompts for one of DEFAULT, returning the char 
          typed, and completing the typein.
          DEFAULT is an alist of (firstchar . restchars) -
          If MESS then print MESS before, and unless 
          TYPEAHEADOKFLG is on, clear buffers before and 
          restore afterwards)


    (PROG ((CNT (ITIMES DWIMWAIT 2))
           R BUFS RSLT)
          [COND
            (MESS [COND
                    ((AND (READP T)
                          (NOT TYPEAHEADOKFLG))
                      (PRIN1 BELLS T)
                      (DOBE)
                      (SETQ BUFS (CLBUFS]
                  (COND
                    ((STRINGP MESS)
                      (PRIN1 MESS T))
                    (T (MAPRINT MESS T NIL "? "]
          (AND (NLISTP DEFAULT)
               (SETQ DEFAULT (SELECTQ DEFAULT
                                      [Y (QUOTE ((Y . es)
                                                 (N . o]
                                      [N (QUOTE ((N . o)
                                                 (Y . es]
                                      NIL)))
      LP  (COND
            [(MINUSP (SETQ CNT (SUB1 CNT)))
              (PRIN1 "...")
              (COND
                ((NLISTP DEFAULT)
                  (PRINT1 DEFAULT T)
                  (RETURN DEFAULT))
                (T (PRIN1 (SETQ R (CAAR DEFAULT)))
                   (GO GOTIT]
            ((NOT (READP T))
              (DISMISS 500)
              (GO LP)))
      RETRY
          (COND
            [(LISTP DEFAULT)
              (SETQ R (RESETFORM (CONTROL T)
                                 (READC T]
            (T (SETQ RSLT (READ T))
               (GO RETURN)))
      GOTIT
          (COND
            ((SETQ RSLT (ASSOC R DEFAULT))
              (PRINT1 (CDR RSLT)
                      T)
              (SETQ RSLT (CAR RSLT)))
            ((OR (EQ R (QUOTE % ))
                 (EQ R (QUOTE %
%))))
              (GO RETRY))
            (T (PRINT1 BELLS T)
               [MAPRINT DEFAULT T "Please type one of: " "--" ", "
                        (FUNCTION (LAMBDA (X)
                            (PRIN1 (CAR X)
                                   T]
               (GO RETRY)))
      RETURN
          (AND BUFS (BKBUFS BUFS))
          (RETURN RSLT])

(PUTPROP
  [LAMBDA (NAM PROP VAL)

          (* This isn't really optimal, as the best 
          implementation would say WHICH PROP needed dumping)


    (/RPLACA (QUOTE CHANGEDPROPLST)
             (CONS NAM CHANGEDPROPLST))
    (/PUT NAM PROP VAL])

(LMLISPFOR
  [LAMBDA (L)
    (PROG (N FV PV EPILOGUE PROLOGUE DOFORM DOTYPE VAR RANGE LST 
             VARNEXT NEXT NEXTS N2 N3 INIT TESTSET DOVAL N1 RETVAL 
             INITIALVAL)
          (SETQ CLISPCHANGE T)
          (SETQ N 1)
      FORLOOP
          (AND
            (PROG1
              (COND
                ((EQ (CAR L)
                     (QUOTE NEW))               (* This COND is for 
                                                whether or not to 
                                                "PROGVAR" the variable)
                  (LISPXPRIN1
                    "NEW specification in FOR statement being deleted:" 
                    T)
                  (COND
                    ((NEQ (EVALV (QUOTE FAULTFN))
                          (QUOTE NOBIND))
                      (LISPXPRIN1 "
{in " T)
                      (LISPXPRIN1 FAULTFN T)
                      (LISPXPRINT "⎇" T)))
                  (LISPXPRINT L T)
                  (/RPLNODE L (CADR L)
                            (CDDR L)))
                ((EQ (CAR L)
                     (QUOTE OLD))
                  (SETQ L (CDR L))
                  NIL)
                (T T))
              [COND
                ((LISTP (CAR L))
                  (COND
                    ((EQ (CAAR L)
                         (QUOTE SETQ))
                      (/RPLNODE L (CADAR L)
                                (CONS (QUOTE IS)
                                      (CONS (CADDR (CAR L))
                                            (CDR L]
              (SETQ VAR (CAR L)))
            (FORPROGVAR VAR))
          (FORNEXT (SETQ VARNEXT (FORVARNAME "NEXT")))
          (SETQ L (CDR L))
          (SETQ N1 (SETQ N2 (SETQ N3 NIL)))
      RANGELOOP
          (AND
            (SELECTQ
              (CAR L)
              (FROM (SETQ N1 (FORGETTOKEN))
                    (GO RANGELOOP))
              (TO (SETQ N2 (FORGETTOKEN))
                  (GO RANGELOOP))
              (BY (SETQ N3 (FORGETTOKEN))
                  (GO RANGELOOP))
              (IN
                (FORTESTANDSET
                  (FORMAKECOND
                    [FORNEGATION (SETQ LST
                                   (COND
                                     ((EQ (CADR L)
                                          (QUOTE OLD))
                                       (SETQ L (CDR L))
                                       (FORGETTOKEN))
                                     (T (FORINITIAL
                                          (FORPROGVAR (FORVARNAME
                                                        "LIST"))
                                          (FORGETTOKEN]
                    (FORGONEXT)))
                (FORTESTANDSET (FORMAKESETQ VAR (LIST (QUOTE CAR)
                                                      LST)))
                (FORNEXT (FORMAKESETQ LST (LIST (QUOTE CDR)
                                                LST)))
                T)
              (ON (FORTESTANDSET (FORMAKECOND (FORNEGATION VAR)
                                              (FORGONEXT)))
                  (FORNEXT (FORMAKESETQ (FORINITIAL VAR (FORGETTOKEN))
                                        (LIST (QUOTE CDR)
                                              VAR)))
                  T)
              (:=(/RPLNODE
                  L
                  (QUOTE FROM)
                  (NCONC
                    (LIST (CAADR L))
                    [AND (CADR (CADR L))
                         (OR [NOT (NUMBERP (CADR (CADR L]
                             (NOT (IGREATERP (CADR (CADR L))
                                             999)))
                         (LIST (QUOTE TO)
                               (CADR (CADR L]
                    [AND (CADDR (CADR L))
                         (LIST (QUOTE BY)
                               (CADDR (CADR L]
                    (CDDR L)))
                (GO RANGELOOP))
              (←(/RPLACA L (QUOTE IS))
                (FORTESTANDSET (FORMAKESETQ VAR (FORGETTOKEN)))
                T)
              (IS (FORTESTANDSET (FORMAKESETQ VAR (FORGETTOKEN)))
                  T)
              (PROGN (OR N1 N2 N3 (ERROR "MISSING OPERATOR IN FOR"))
                     NIL))
            (OR N1 N2 N3)
            (ERROR "TOO MANY OPERATORS IN FOR"))
          [COND
            ((OR N1 N2 N3)
              (FORINITIAL VAR (OR N1 1))
              (AND (LISTP N2)
                   (SETQ N2 (FORINITIAL (FORPROGVAR (FORVARNAME "MAX"))
                                        N2)))
              (SETQ N3 (COND
                  [N3 (COND
                        ((ATOM N3)
                          N3)
                        (T (FORINITIAL (FORPROGVAR (FORVARNAME "INC"))
                                       N3]
                  ((AND (NUMBERP N1)
                        (NUMBERP N2)
                        (GREATERP N1 N2))
                    -1)
                  (T 1)))
              [AND
                N2
                (FORTESTANDSET
                  (FORMAKECOND
                    (COND
                      [(NOT (NUMBERP N3))
                        (LIST (QUOTE COND)
                              (LIST (LIST (QUOTE MINUSP)
                                          N3)
                                    (LIST (QUOTE ILESSP)
                                          VAR N2))
                              (LIST T (LIST (QUOTE OR)
                                            (LIST (QUOTE ZEROP)
                                                  N3)
                                            (LIST (QUOTE GREATERP)
                                                  VAR N2]
                      ((MINUSP N3)
                        (LIST (QUOTE ILESSP)
                              VAR N2))
                      (T (LIST (QUOTE IGREATERP)
                               VAR N2)))
                    (FORGONEXT]
              (FORNEXT (FORMAKESETQ VAR (LIST (QUOTE IPLUS)
                                              VAR N3]
      ASLOOP
          (SELECTQ (CAR L)
                   (AS (SETQ L (CDR L))
                       (SETQ NEXTS (APPEND NEXTS NEXT))
                       (SETQ NEXT)
                       (GO FORLOOP))
                   [IF (/RPLACA L (QUOTE WHEN))
                       (FORTESTANDSET (FORMAKECOND (FORNEGATION
                                                     (FORGETTOKEN))
                                                   (LIST (QUOTE GO)
                                                         VARNEXT]
                   [WHEN (FORTESTANDSET (FORMAKECOND
                                          (FORNEGATION (FORGETTOKEN))
                                          (LIST (QUOTE GO)
                                                VARNEXT]
                   [UNTIL (FORNEXT (FORMAKECOND (FORGETTOKEN)
                                                (FORGONEXT]
                   [WHILE (FORTESTANDSET (FORMAKECOND (FORNEGATION
                                                        (FORGETTOKEN))
                                                      (FORGONEXT]
                   (GO FORTEST))
          (GO ASLOOP)
      FORTEST
          (SETQ PROLOGUE (APPEND TESTSET (LIST (FORPACKWORDS "LOOP" N))
                                 INIT PROLOGUE))
          [SETQ EPILOGUE (CONS (FORPACKWORDS "NEXT" N)
                               (APPEND (REVERSE NEXT)
                                       (REVERSE NEXTS)
                                       (CONS (LIST (QUOTE GO)
                                                   (FORPACKWORDS "LOOP" 
                                                                 N))
                                             EPILOGUE]
          [SETQ TESTSET (SETQ INIT (SETQ NEXT (SETQ NEXTS]
          (COND
            ((EQ (CAR L)
                 (QUOTE FOR))
              (SETQ L (CDR L))
              (SETQ N (ADD1 N))
              (GO FORLOOP)))                    (* Here is where we test
                                                for the "VALUE" of the 
                                                for)
          (FORPROGVAR (QUOTE FOR-VALUE))

          (* Go off the I.S.TYPE property which warren uses, 
          or the association list here, which is of the form 
          (settingform initialization returning 
          whattodowithafirst) -
          I.S.TYPE is of same form except the 
          what-to-do-with-first part)


      FVLP[SETQ FV
            (OR (CDR (FASSOC (CAR L)
                             FORTYPELST))
                (GETP (CAR L)
                      (QUOTE I.S.TYPE))
                (HELP (QUOTE (MAKE THIS A REGULAR FOR TYPE]
          (COND
            ((NLISTP FV)
              (/RPLACA L FV)
              (GO FVLP)))
          (SETQ L (CDR L))
      FIRSTLP
          (SELECTQ (CAR L)
                   [FIRST (SETQ INITIALVAL (SUBST (FORGETTOKEN)
                                                  (QUOTE *)
                                                  (OR (CADDDR FV)
                                                      (QUOTE *]
                   [FINALLY (SETQ RETVAL (LIST (FORGETTOKEN]
                   (GO FINISHUP))
          (GO FIRSTLP)
      FINISHUP
          (SETQ DOFORM (SUBPAIR (QUOTE ($$VAL * I.V.))
                                (LIST (QUOTE FOR-VALUE)
                                      (CAR (LAST (FOREXPRESSIONS)))
                                      VAR)
                                (CAR FV)))
          (FORINITIAL (QUOTE FOR-VALUE)
                      (OR INITIALVAL (CADR FV)))
          [SETQ RETVAL
            (SUBST (SUBST (QUOTE FOR-VALUE)
                          (QUOTE $$VAL)
                          (OR (CADDR FV)
                              (QUOTE $$VAL)))
                   (QUOTE $$VAL)
                   (COND
                     [RETVAL (COND
                               ((EQ (CAAR RETVAL)
                                    (QUOTE RETURN))
                                 RETVAL)
                               (T (CONS (CAR RETVAL)
                                        (QUOTE ((RETURN $$VAL]
                     (T (QUOTE ((RETURN $$VAL]

          (* In a finally, the * means what would be returned 
          ordinarily; i.e. $val; so that finally 
          (RETURN <I *>) means to return i consed onto the 
          value; this hair is so that list finally <i *> will 
          work)


          (RETURN (CONS (QUOTE PROG)
                        (CONS PV (NCONC INIT (DREVERSE PROLOGUE)
                                        (LDIFF L (NLEFT L 1))
                                        (LIST DOFORM)
                                        EPILOGUE
                                        (CONS (QUOTE RETURN)
                                              RETVAL])

(FORGETTOKEN
  [LAMBDA NIL
    (PROG ((VARS (APPEND VARS PV)))
          (DWIMIFY1B (CDR L)
                     L
                     (CDR L)
                     T T FAULTFN))
    (PROG1 (CADR L)
           (SETQ L (CDDR L])

(FOREXPRESSIONS
  [LAMBDA NIL
    (PROG ((VARS (APPEND VARS PV)))
          (DWIMIFY1B L L L T NIL FAULTFN))
    L])

(FORNEXT
  [LAMBDA (ITEM)
    (SETQ NEXT (CONS ITEM NEXT))
    ITEM])

(FORVARNAME
  [LAMBDA (STR)
    (PACK (LIST STR " " VAR])

(FORMAKECOND
  [LAMBDA (PRD DO)
    (LIST (QUOTE COND)
          (LIST PRD DO])

(FORMAKESETQ
  [LAMBDA (VAR VAL)
    (AND (NOT (EQ VAR VAL))
         (LIST (QUOTE SETQ)
               VAR VAL])

(FORINITIAL
  [LAMBDA (VAR VAL)
    (AND VAL (SETQ INIT (CONS (FORMAKESETQ VAR VAL)
                              INIT)))
    VAR])

(FORPROGVAR
  [LAMBDA (VAR)
    (SETQ PV (CONS VAR PV))
    VAR])

(FORGONEXT
  [LAMBDA NIL
    (LIST (QUOTE GO)
          (COND
            ((EQ N 1)
              (QUOTE RETURN))
            (T (PACK (LIST "NEXT " (SUB1 N])

(FORPACKWORDS
  [LAMBDA (STR VAL)
    (PACK (LIST STR " " N])

(FORTESTANDSET
  [LAMBDA (ITEM)
    (SETQ TESTSET (CONS ITEM TESTSET))
    ITEM])

(FORNEGATION
  [LAMBDA (EXP)
    (SELECTQ (CAR EXP)
             ((NOT NULL)
               (CADR EXP))
             (LIST (QUOTE NULL)
                   EXP])

(EDITM
  [NLAMBDA X
    (EDITL (LIST (OR (ASSOC (CAR X)
                            USERMACROS)
                     (ERROR (CAR X)
                            "not editable"))
                 USERMACROS)
           (CDR X)
           (CAR X)
           (QUOTE edit))
    (CAAR (/RPLACA (QUOTE CHANGEDITMACROS)
                   (CONS (CAR X)
                         CHANGEDITMACROS])
)
  (ADDTOVAR USERMACROS [?= NIL (ORR ((E (?= (##))
                                        T))
                                    ((E (QUOTE ?=?]
            (- NIL (ORR (NX)
                        (!NX)))
            [EVAL NIL (E (EVAL (##]
            [?= NIL (ORR [(E (MAP2C (ARGLIST (## 1))
                                    (## 2 UP)
                                    (FUNCTION (LAMBDA (X Y)
                                                      (PRIN1 X T)
                                                      (PRIN1 " = " T)
                                                      (PRINT Y T]
                         ((E (QUOTE ?=?]
            [EF NIL (ORR [(E (APPLY* (QUOTE EDITF)
                                     (COND ((LISTP (## UP 1))
                                            (## UP 1 1))
                                           (T (## UP 1]
                         ((E (QUOTE EF?]
            (MAC (X . Y)
                 (E (/RPLACA (QUOTE CHANGEDITMACROS)
                             (CONS (COND ((LISTP (QUOTE X))
                                          (CAR (QUOTE X)))
                                         (T (QUOTE X)))
                                   CHANGEDITMACROS))
                    T)
                 (M X . Y))
            [PPT NIL (ORR ((E (RESETVAR PRETTYTRANFLG T (## PP))
                              T))
                          ((E (QUOTE PPT?]
            (!← NIL !0))
  (ADDTOVAR EDITCOMSA !← PPT EF ?= EVAL - ?=)
  (ADDTOVAR EDITCOMSL MAC)
  (ADDTOVAR PRETTYTYPELST (CHANGEDITMACROS USERMACROS "edit macros")
            (NEWVARSLST VARS "variables")
            (CHANGEDPROPLST PROP "properties")
            (CHANGEDADVICELST ADVICE "advice"))
  [ADDTOVAR PRETTYMACROS (* X (E (TERPRI)
                                 (PRINT (QUOTE (* . X)))
                                 (TERPRI]
  (RPAQ DWIMUSERFN T)
  (RPAQ HOST)
  (RPAQ NEWVARSLST)
  (RPAQ CHANGEDITMACROS)
  (RPAQ CHANGEDPROPLST)
  (RPAQ CHANGEDADVICELST)
  (RPAQQ LMFORWORDS
         (FINALLY FIRST FOR WHILE UNTIL IF WHEN AS IS := ON IN BY TO 
                  FROM NEW SUM IPLUS ITIMES PRODUCT AND ALWAYS OR 
                  ISSOME PROGN PROG2 DO NCONC LIST COLLECT THEREIS 
                  SUCHTHAT JOIN XLIST APPEND MAXIMUM MAX MINIMUM MIN))
  (RPAQQ FORTYPELST ((SUM (SETQ $$VAL (IPLUS $$VAL *))
                          0)
          (IPLUS . SUM)
          (ITIMES . PRODUCT)
          (PRODUCT (SETQ $$VAL (ITIMES $$VAL *))
                   1)
          (AND . ALWAYS)
          (ALWAYS (OR (SETQ $$VAL *)
                      (RETURN))
                  T)
          (OR . ISSOME)
          (ISSOME (AND (SETQ $$VAL *)
                       (RETURN $$VAL)))
          (PROGN (SETQ $$VAL *))
          (PROG2 . PROGN)
          (DO *)
          (NCONC . JOIN)
          (LIST . COLLECT)
          (COLLECT (SETQ $$VAL (TCONC $$VAL *))
                   NIL
                   (CAR $$VAL)
                   (LCONC NIL *))
          (THEREIS (AND * (RETURN I.V.))
                   NIL NIL (AND * (RETURN T)))
          (SUCHTHAT (AND * (RETURN I.V.))
                    NIL NIL (AND * (RETURN T)))
          (JOIN (SETQ $$VAL (LCONC $$VAL *))
                NIL
                (CAR $$VAL)
                (LCONC NIL *))
          (XLIST (SETQ $$VAL (CONS * $$VAL)))
          (APPEND (SETQ $$VAL (LCONC $$VAL (APPEND *)))
                  NIL
                  (CAR $$VAL)
                  (LCONC NIL (APPEND *)))
          (MAXIMUM (SETQ $$VAL (MAX $$VAL *))
                   -9999999 $$VAL)
          (MAX . MAXIMUM)
          (MINIMUM (SETQ $$VAL (MIN $$VAL *))
                   9999999 $$VAL)
          (MIN . MINIMUM)))
(DEFLIST(QUOTE(
  (FOR (FOREXP (LMLISPFOR FOREXP)))
))(QUOTE CLISPMACRO))

(DEFLIST(QUOTE(
  (FOR (USERWORD . FOR))
))(QUOTE CLISPWORD))

  (/PUT (QUOTE *)
        (QUOTE PRETTYTYPE)
        (QUOTE [LAMBDA NIL NIL]))
  (I.S.TYPE (QUOTE MAXIMUM)
            (QUOTE (SETQ $$VAL (MAX $$VAL *)))
            -999999
            (QUOTE $$VAL))
  (I.S.TYPE (QUOTE MINIMUM)
            (QUOTE (SETQ $$VAL (MIN $$VAL *)))
            999999
            (QUOTE $$VAL))
(DECLARE
  (BLOCK: FORBLOCK LMLISPFOR FORGETTOKEN FOREXPRESSIONS FORNEXT 
          FORVARNAME FORMAKECOND FORMAKESETQ FORINITIAL FORPROGVAR 
          FORGONEXT FORPACKWORDS FORTESTANDSET FORNEGATION
          (ENTRIES LMLISPFOR)
          (LOCALFREEVARS TESTSET N INIT VAR NEXT VARS PV L))
)STOP